perm filename PFAIL.OLD[MSS,LCS]1 blob
sn#182670 filedate 1975-10-18 generic text, type T, neo UTF8
00100 TITLE PFAIL; ********* OCT 16,75 *********
00200 INTERNAL LOOK,LOOKD,LOOKF
00300 ENTRY GETPTS,MOVIT,EXTEN,PNRN,DBAR,SORT,SHIFT,SHFT1
00350 ENTRY ADRST,SHFT0,PSHFT,ENDL,STAFF,RIGHT,LOOP1,RESTS
00360 ENTRY EXCHG
00400 DEFINE ERROR (MSG)
00500 < JSA 16,.ERROR
00600 JUMP [ASCIZ/MSG/
00700 ]
00800 >
00900
01000 .ERROR: 0
01100 OUTSTR [ASCIZ/?
01200 /] ;MAKE SURE HE CAN SEE HIS ERROR
01300 OUTSTR @(16) ;OUTPUT ERROR MESSAGE
01400 CALLI 1,12 ;LET USER CONTI2UE
01500 JRA 16,1(16)
01600
01700 CH←13
01800
01900 REGS: BLOCK 20
02000
02100 ;LOOK(<FILE>) FOR NO EXT., LOOKD() FOR .DAT, LOOKF() FOR .DMD
02200
02300
02400 LOOKF: 0
02500 MOVSI 0,'DMD'
02600 JRST LOOK1
02700 LOOKD: 0
02800 MOVSI 0,'DAT'
02900 JRST LOOK1
03000 LOOK: 0
03100 MOVEI 0,0
03200 LOOK1: MOVEM 0,DIR+1
03300 MOVE 0,@(16)
03400 MOVEM 0,FILNAM
03500 JSA 16, INTFIQ
03600 SETZM DIR+2
03700 SETZM DIR+3
03800 LOOKUP CH,DIR
03900 TDZA 0,0
04000 MOVNI 0,1
04100 JRA 16,1(16)
04200
04300 INTFIQ: 0 ;INITS DSK FOR INPUT
04400 MOVEI REGS
04500 BLT REGS+3
04600 INIT CH,17
04700 SIXBIT/DSK/
04800 0
04900 HALT .-3
05000 ; ERROR <CAN'T INIT DSK!>
05100
05200 INTF4: MOVE 0,FILNAM#
05300 MOVEM 0,FN#
05400 MOVE 1,[POINT 7,FN]
05500 INTF3: MOVE 2,[POINT 6,DIR]
05600 SETZM DIR
05700 MOVEI 3,5
05800 INTF1: ILDB 0,1
05900 CAIN 0," "
06000 JRST INTF2
06100 SUBI 0,40
06200 IDPB 0,2
06300 SOJG 3,INTF1
06400 INTF2: HRLZI REGS
06500 BLT 3
06600 JRA 16,0(16)
06700
06800 DIR: BLOCK 4
06900 EXTERNAL .COMM.,XRN,KJY,PTR,POSI,AMOD,KNR,NNP,PX,XXX,Q,SF,LLL
07000 EXTERNAL RCLF
07100 K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
07200 DEFINE FIXX(N)
07300 < JUMPGE N,.+5
07400 MOVNS N
07500 FIX N,233000
07600 MOVNS N
07700 CAIA
07800 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
07900
08000 ; SUBROUTINE GETPTS
08100 ; COMMON/KNR/N(500) /NNP/NP(500)
08200 ;XXX COMMON/XRN/RN(4000) /KJY/ K,J
08300 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
08400 ;XXX 1/PTR/PWDS(250),ITEM,LL,I,IX
08500 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
08600 ; 1,(R6,RJQ(4))
08700
08800 GETPTS: 0 ;CALL GETPTS(N,RN,PWDS)
08900 SETZ J, ; J=0
09000 SETZ K, ; K=0
09100 MOVE JJ2,POSI+=8
09200 MOVE R2,.COMM.
09300 SETZ X,
09400 ;; MOVE X,@(16)
09500 ;; SOJ X
09600 MOVEI M,@2(16); DO 1 M=1,ITEM
09700 ; ADDI M,(X)
09800 G1: AOJ X,
09900 MOVE L,(M)
10000 FIXX(L)
10100 MOVEI R,@1(16) ;L=PWDS(M)
10200 ADDI R,(L) ;IF(RTLINE(L))GO TO 1
10300 ;* MOVE 1,1(R) ;RN(L+2)
10400 ;;NEVER USED IN 'PARTS'- CAML R2,[=5.0]
10500 ;; JRST GZ
10600 CAME R2,1(R)
10700 JRST GX
10800 ;;GZ: MOVE A,.COMM.+7 ;RY=RN(L+1)
10900 ;; JUMPLE A,G9 ;F(R6.LE.0)GO TO 9
11000 ;; CAME A,(R) ;IF(R6.NE.RY)GO TO 1
11100 ;; JRST GX
11200 ; CHECK CODE NUM
11300 G9: MOVE A,2(R)
11400 CAMLE A,.COMM.+6 ;R5
11500 JRST G2 ;9 IF(OUTLIM(R4,R5,RN(L+3)))GO TO 2
11600 CAMGE A,.COMM.+5 ;R4
11700 JRST G2
11800
11900 SKIPG JJ2
12000 MOVE JJ2,X
12100 MOVE .COMM.+=8 ;RN(L+2)=R7
12200 MOVEM 1(R)
12300 AOJ J,
12400 ; IN LIMITS?
12500 ; MOVEI A,XRN+=2498 ;J=J+1
12600 ;; MOVEI A,KNR-1
12700 ;; ADDI A,(J)
12800 MOVEI 0,(L)
12900 AOJ K, ;K=K+1
13000 ;; MOVEI 1,NNP-1
13100 ;; ADDI 1,(K) ;NP(K)=L
13200 MOVEM 0,NNP-1(K)
13300 ADDI 0,3 ;N(J)=L+3
13400 MOVEM 0,KNR-1(J)
13500 ; NP IS FOR USE IN JUSTIFY ROUTINE
13600 G2: MOVE RY,(R) ;2 IF(RY.LT.4)GO TO 1
13700 CAMGE RY,[=4.0]
13800 JRST GX
13900 CAMN RY,[=44.0] ;CODE 4 IS SOMETIMES =44
14000 JRST G5 ;FOUND A LINE
14100 CAMLE RY,[=7.0]
14200 JRST GX ;IF(RY.GT.7)GO TO 1
14300 ; TWO-ENDED ITEM?
14400 MOVE RZ,-1(R) ;RZ=RN(L)
14500 ; WD CNT
14600 ;; CAMN RY,[=4.0] ;GO TO(4,5,6,7),IFIX(RY)-3
14700 ;; JRST G4
14800 ;; CAMN RY,[=5.0]
14900 ;; JRST G5
15000 ;; CAMN RY,[=6.0]
15100 ;; JRST G6
15200 ;; CAMG RZ,[=4.0] ;4 IF(RZ.GT.2)GO TO 5
15300 ;; JRST G5 ; THERE IS A TRILL WIGGLE
15400 ;; JRST GX ;GO TO 1 -- NO WIGGLE (P7≠0)
15500 FIXX(RY)
15600 XCT TBL-4(RY) ; NEXT REPLACES THE ABOVE.
15700 JRST G5
15800 JRST GX
15900 TBL: JRST G4
16000 JRST G5
16100 JRST G6
16200 CAMG RZ,[4.0]
16300
16400 G4: CAMG RZ,[=2.0] ;7 IF(RZ.GT.3)GO TO 5
16500 JRST GX
16600 JRST G5 ;GO TO 1
16700 G6: CAMGE RZ,[=8.0] ;6 IF(RZ.LT.8)GO TO 8
16800 JRST G8
16900 ;; MOVEI 1,XRN ;IF(RN(L+10).LT.30)GO TO 8
17000 ;; ADDI 1,(L)
17100 ;; MOVE 1,11(1)
17200 MOVE 1,=9(R)
17300 CAMGE 1,[=30.0]
17400 JRST G8
17500 MOVE A,7(R) ; IF(OUTLIM(R4,R5,RN(L+8)))GO TO 8
17600 CAMLE A,.COMM.+6
17700 JRST G8
17800 CAMGE A,.COMM.+5
17900 JRST G8
18000 SKIPG JJ2
18100 MOVE JJ2,X
18200 AOJ J,
18300 ; IN LIMITS?
18400 ; MOVEI A,XRN+=2498 ;J=J+1
18500 ; ADDI A,(J)
18600 MOVEI 0,8(L) ;J=J+1
18700 ;; ADDI 0,=8 ;N(J)=L+8
18800 MOVEM 0,KNR-1(J)
18900 G8: CAMGE RZ,[=7.0] ;8 IF(RZ.LT.7)GO TO 5
19000 JRST G5
19100 ;; MOVE A,6(R) ;IF(RN(L+7))GO TO G8B
19200 ;; JUMPL A,G8B ; P7 IS NEG FOR TREMOLO
19300 ;; MOVE A,7(R) ;IF(RN(L+8).NE.0)GO TO G8B
19400 ;; JUMPN A,G8B
19500 SKIPL 6(R)
19600 SKIPE 7(R)
19700 JRST G8B
19800
19900 CAMGE RZ,[=8.0]
20000 JRST G5 ;IF(RZ.LT.8)GO TO G5
20100 MOVE A,=9(R) ;IF(RN(L+10).EQ.0)GO TO G5
20200 JUMPE A,G5 ;PASSES NUMBER OVER BEAM.
20300 G8B: MOVE A,8(R)
20400 CAMLE A,.COMM.+6
20500 JRST G5
20600 CAMGE A,.COMM.+5 ;R4
20700 JRST G5
20800
20900 SKIPG JJ2
21000 MOVE JJ2,X
21100 AOJ J, ;J=J+1
21200 ; IN LIMITS?
21300 ; MOVEI A,XRN+=2498 ;J=J+1
21400 ; ADDI A,(J)
21500 MOVEI 0,=9(L)
21600 ;; ADDI 0,=9 ;IF(OUTLIM(R4,R5,RN(L+9)))GO TO 5
21700 MOVEM 0,KNR-1(J) ;N(J)=L+9
21800 G5: MOVE A,5(R)
21900 CAMLE A,.COMM.+6
22000 JRST GX
22100 CAMGE A,.COMM.+5 ;R4
22200 JRST GX
22300
22400 SKIPG JJ2
22500 MOVE JJ2,X
22600 AOJ J,
22700 ; IN LIMITS?
22800 ;| MOVEI A,XRN+=2498 ;J=J+1
22900 ;; ADDI A,(J)
23000 MOVEI 0,6(L) ;5 IF(OUTLIM(R4,R5,RN(L+6)))GO TO 1
23100 ;; ADDI 0,6 ;N(J)=L+6
23200 MOVEM 0,KNR-1(J)
23300 ;;GX: CAMGE X,PTR+=250 ;1 CONTINUE
23301 GX: CAMGE X,LLL ;1 CONTINUE
23400 AOJA M,G1
23500 MOVEM JJ2,POSI+=8
23600 MOVEM J,KJY+1
23700 MOVEM K,KJY
23800 JRA 16,3(16)
23900
24000 ; SUBROUTINE MOVIT(RN)
24100 ; COMMON /KNR/ N(500)
24200 ; COMMON /KJY/ DONT,J
24300 ; COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS
24400 ; EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R9,RJQ(7))
24500 ; 1,(R6,RJQ(4)),(N,RN(2500)),(R8,RJQ(6))
24600 MOVIT: 0 ;RDIS=(R9-R8)/(R5-R4)
24700 MOVE R,.COMM.+=10
24800 FSBR R,.COMM.+=9
24900 MOVE RY,.COMM.+6
25000 FSBR RY,.COMM.+5
25100 FDVR R,RY
25200 ; MOVEI L,XRN+=2499 ; DO 1 K=1,J
25300 MOVEI L,KNR
25400 SETZ K,
25500 MOVE 0,.COMM.+=10 ; SET UP R9
25600 ;;M1: MOVE X,L ; L=N(K)
25700 ;; MOVE A,(X)
25800 M1: MOVE A,(L)
25900 MOVEI R2,@(16) ;RA=RN(L)
26000 ADDI R2,(A)
26100 MOVEI RZ,(R2)
26200 MOVE R2,-1(R2)
26300 CAMGE R2,.COMM.+5 ;IF(OUTLIM(R4,R5,RA))GO TO 1
26400 JRST MX
26500 CAMLE R2,.COMM.+6
26600 JRST MX
26700 JUMPE 0,M2 ;IF(R9.NE.0)RA=(RA-R4)*RDIS
26800 FSBR R2,.COMM.+5
26900 FMPR R2,R
27000 M2: FADR R2,.COMM.+=9 ; RN(L)=R8+RA
27100 MOVEM R2,-1(RZ)
27200 MX: AOJ K, ;1 CONTINUE
27300 CAMGE K,KJY+1
27400 AOJA L,M1
27500 JRA 16,1(16)
27600
27700 EXTEN: 0 ;FUNCTION EXTEN(X)
27800 HRRM 16,.+2
27900 JSA 16,AMOD ;EXTEN=AMOD(X,1.)*10.
28000 JUMP @0
28100 JUMP [=1.0]
28200 FMPR [=10.0]
28300 JRA 16,1(16)
28400
28500
28600 DBAR: 0 ; CALL DBAR(K,ITEM,J)
28700 MOVE 4,@2(16) ; -J-RR=RN(J+3)
28800 MOVE 2,XRN+3(4) ; -RN(J+4)-
28900 FIXX(2) ;KZ=RN(J+4)/100.
29000 IDIVI 2,=100
29100 IMULI 2,=100 ;RN(J+4)=1.+KZ*100.
29150 AOJ 2,
29200 TLC 2,232000
29300 FADR 2,2 ;FLOAT IT
29400 MOVEM 2,XRN+3(4)
29500
29510 MOVE 1,@1(16)
29555 ;;??? SOJ 1, ; ITEM-1
29600 MOVE 7,XRN+2(4) ; -RR-
29700 MOVE 4,@(16) ; DO 82 KY=K+1,ITEM
29800 DB: MOVE 5,PTR(4) ;KZ=PWDS(KY)
29900 FIXX(5) ; -KY-
30000 MOVE 6,XRN(5) ; IF(RN(KZ+1).NE.4)GO TO 82
30100 CAME 6,[4.0]
30200 JRST DB82
30300 MOVE 6,XRN-1(5) ;IF(RN(KZ).NE.2)GO TO 82
30400 CAME 6,[2.0]
30500 JRST DB82
30600 ;;C AVOIDS DUPLICATE BARS.
30700 MOVN 6,XRN+2(5) ;IF(ABS(RR-RN(KZ+3)).GT..5)GO TO 82
30800 FADR 6,7
30900 SKIPGE 6
31000 MOVNS 6
31100 CAMLE 6,[0.5]
31200 JRST DB82
31300 MOVE 6,[99.0] ;RN(KZ+2)=99
31400 MOVEM 6,XRN+1(5)
31500 SETZM XRN(5) ;RN(KZ+1)=0
31600 DB82: AOJ 4, ;82 CONTINUE
31700 CAIGE 4,(1)
31800 JRST DB
31850 MOVEM 7,SHFT1 ; RR SAVES IT FOR ADRST ROUTINE
31900 JRA 16,3(16)
32000
32100 PNRN: 0 ; CALL PNRN(J,XWDS,K)
32200 MOVE 4,@(16) ;810 JA=PWDS(K+1)
32300 ;; MOVE 3,.COMM. ;RN(J+2)=RS
32400 SETZM XRN+1(4)
32500 MOVE 5,@2(16) ; DO 7 KY=J,JA-1
32600 MOVE 5,PTR(5)
32700 FIXX(5) ; -JA-
32800 MOVE 6,XXX ; PN(LK)=RN(KY)
32850 MOVEI 1,(6) ; SAVE IT FOR A LITTLE LATER
32900 PN: MOVE 7,XRN-1(4) ;7 LK=LK+1
33000 MOVEM 7,PX-1(6)
33200 AOJ 4,
33300 CAME 4,5
33400 AOJA 6,PN
33410 AOJ 6,
33420 MOVE 2,.COMM.+6 ; IF(R5)GO TO 6666
33425 JUMPL 2,PN2 ; IF(PN(J).EQ.2)LK=LK+1
33430 MOVEM 2,PX+4(1) ; PN(J+5)=R5
33435 MOVE 3,[3.0]
33437 PN3: CAMLE 3,PX-1(1) ; IS THE WDCNT BIG ENOUGH?
33438 AOJ 6, ; ADD 1
33440 MOVEM 3,PX-1(1) ; PN(J)=3 OR 4
33450 JRST PN1
33460 PN2: MOVE 3,RCLF ; IF(R.NE.17)GO TO
33470 CAME 3,[17.0]
33480 JRST PN1
33490 MOVE 3,[4.0] ; THE WDCNT
33500 MOVE 2,RCLF+1 ; CLEF #
33510 MOVEM 2,PX+5(1) ;PN(J+6)=CLEF
33520 JRST PN3
33660 PN1: MOVEM 6,XXX ;LK=LK+1 (6666↑)
33670 MOVE 4,LLL ; -L-
33700 TLC 6,232000 ;XWDS(L)=LK
33800 FADR 6,6
33900 ADD 4,1(16) ; ADDR. XWDS ARRAY
34000 MOVEM 6,(4)
34100 AOS LLL ;L=L+1
34200 JRA 16,3(16)
34300 SORT: 0 ; CALL SORT(XWDS)
34310 MOVE 11,LLL ; L
34320 SOJ 11,
34400 MOVEI 4,1 ;I=1
34500 SETZ 5, ; -K- DO 243 K=1,L-1
34600 S2: MOVE 7,(16) ; ADDR. OF XWDS
34700 ADDI 7,(5) ;LB=XWDS(K)+1
34800 MOVE 6,(7)
34900 FIXX(6) ; I DON'T NEED THE -1.
35000 MOVE 10,PX(6) ;IF(PN(LB).NE.16)GO TO 243
35100 CAME 10,[16.0]
35200 JRST S243
35300 MOVE 10,PX-1(6) ;IF(PN(LB-1).LT.8)GO TO 243
35400 CAMGE 10,[8.0]
35500 JRST S243
35600 MOVE 10,-1(7) ;JL=XWDS(K-1)
35700 FIXX(10)
35800 MOVE 10,PX+2(10)
35900 MOVEM 10,PX+2(6) ;244 PN(LB+2)=PN(JL+3)
36000 S243: AOJ 5,
36100 CAME 5,11 ; -L-1
36200 JRST S2 ; 243 CONTINUE
36300
36400 ;; PUTS CONTINUATION OF TEXT IMMEDIATELY AFTER PREV. POS.
36500 ;; FOR SPACING PROBLEMS BELOW.
36600 MOVEI 11,1 ;M=2
36700 SETZ 12, ;J=1
36800 S24: MOVE 13,[100000.0] ;24 RA=100000.
36900 ;; POSITION
36910 MOVE 1,LLL ; L
36920 SOJ 1,
37000 SETZ 14, ; -K-
37100 S21: MOVE 2,(16) ;DO 21 K=1,L-1 - ADDR. OF XWDS -
37200 ADDI 2,(14) ;JL=XWDS(K)+3
37300 MOVE 2,(2)
37400 FIXX(2) ; -JL- (NO +3)
37500 MOVE 3,PX+2(2) ;R=PN(JL)
37600 CAMN 3,[100000.0]
37700 JRST SX21 ;IF(R.EQ.100000)GO TO 21
37800 MOVE 3 ;241 IF(ABS(R-RA).GT..1)GO TO 240
37900 FSBR 13
38000 SKIPGE
38100 MOVNS
38200 CAMLE 0,[0.1]
38300 JRST S240
38400 MOVEM 13,PX+2(2) ; ((R=RA)) PN(JL)=R
38500 ;; PUT IN HERE MULTI-VOICE TRAP SOMEDAY
38600 JRST SX21 ;GO TO 21
38700 S240: CAMLE 3,13 ;240 IF(R.GT.RA)GO TO 21
38800 JRST SX21
38900 ;; LINES THEM UP
39000 MOVEI 4,(2) ; SAVES JL (I=K)
39200 MOVE 13,3 ; RA=R ;21 CONTINUE
39300 SX21: AOJ 14, ; -K-
39350 CAME 14,1
39450 JRST S21
39600 CAMN 13,[100000.0] ;IF(RA.EQ.100000)GO TO 23
39700 JRA 16,1(16); JUMP IF ALL SORTED
39800 ;;;; MOVE 10,(16) ;242 JL=XWDS(I)
39900 ;;;; ADDI 10,(4)
40000 ;;;; MOVE 10,(10) ; AC4 IS I-1
40100 ;;;; FIXX(10) ; -JL-
40200 MOVEI 15,(4) ;LA=JL
40300 MOVE 1,PX-1(4) ;N=PN(JL)+3
40400 FADR 1,[3.0] ; N NOT FIXED YET!
40500 MOVE 2,PTR-1(11) ; PWDS(M)=PWDS(M-1)+N
40600 FADR 2,1
40700 MOVEM 2,PTR(11)
40800 AOJ 11, ; M=M+1
40900 FIXX(1) ;DO 22 K=J,J+N-1
40950 ADDI 1,(12) ; -J+N-
40960 ;; SOJ 1,
41000 S22: MOVE 2,PX-1(4) ; RN(K)=PN(JL)
41100 MOVEM 2,XRN(12)
41300 AOJ 12,
41400 CAME 12,1
41500 AOJA 4,S22 ;22 JL=JL+1
41510 AOJ 4, ; (JL=JL+1)
41550 ;; AOJ 12, ; (J=J+N)
41600 MOVE 2,[100000.0] ; PN(LA+3)=100000
41700 MOVEM 2,PX+2(15) ; PUT IT ASIDE
41800 ;? AOJ 12, ; (J=N+J)
41900 JRST S24 ; GO TO 24
42000 SHIFT: 0 ; CALL SHIFT
42020 SOS LLL ; (IN MAIN. L=L-1)
42100 SETZ 2, ;K=1
42200 SETZ 3, ;L=1
42400 SETO 4, ;LK=1 ((LL=0))
42500 SH221: MOVE 5,PX(2) ;221 IF(Q(IFIX(PN(K))+1))GO TO 321
42510 FIXX(5)
42520 MOVE 6,Q(5)
42530 JUMPL 6,SH321
42540 MOVE 7,PX+1(2)
42550 FIXX(7)
42600 SH421: MOVE 6,Q-1(5) ;DO 421 KL=IFIX(PN(K)),IFIX(PN(K+1))-1
42700 MOVEM 6,Q(3) ; ((LL=LL+1))421 Q(LL)=Q(KL)
42900 AOJ 5,
42910 CAMGE 5,7
42920 AOJA 3,SH421
42930 AOJ 4, ;LK=LK+1
42965 AOJ 3,
43000 MOVE 1,3 ;PN(LK)=LL+1
43010 AOJ 1,
43020 TLC 1,232000
43030 FADR 1,1
43040 MOVEM 1,PX+1(4)
43100 SH321: AOJ 2, ;321 K=K+1
43200 CAMGE 2,LLL ; (L) IF(K.LT.KK)GO TO 221
43210 JRST SH221
43220 AOJ 4,
43300 MOVEM 4,LLL ; L=LK-1
43400 ;; L=NUMBER OF ITEMS FOR RHY RECONS.
43410 JRA 16,(16)
43420
43430 SHFT1: 0 ; CALL SHFT1(KQ)
45000 MOVEI 2,1 ; -L- (KK=1)
45002 MOVEI 3,1 ; K
45005 MOVE 6,[1.0] ; -K-
45010 SP: MOVE 4,Q-1(3) ;220 JJ=Q(K)+3
45015 FADR 4,[3.0]
45050 MOVEM 6,PX-1(2)
46000 ;;NEW POINTER
46100 ;K=K+JJ
46200 FADR 6,4 ; -K- (KK=KK+1)
46250 MOVE 3,6
46275 FIXX(3)
46300 CAMGE 3,@(16) ;IF(K.LT.KQ)GO TO 220
46310 AOJA 2,SP
46400 AOJ 2, ;PN(KK)=K
46420 MOVEM 6,PX-1(2)
46430 MOVEM 2,LLL ;L=KK
46440 JRA 16,1(16)
46450
46500
46510 SHFT0: 0 ; CALL SHFT0(KQ)
46520 MOVE 2,LLL ; L
46530 MOVE 4,PTR-1(2)
46540 FIXX(4)
46550 SOJ 4,
46560 MOVE 2,@(16) ; KQ
46570 ;; SETZ 3, ; K
46580 ;;SH32: MOVE XRN(3) ; DO 32 K=1,IFIX(PWDS(L))-1
46590 ;; MOVEM Q(2) ; KQ=KQ+1
46610 ;; AOJ 3,
46620 ;; CAME 3,4
46630 ;; AOJA 2,SH32
46635 ;; AOJ 2, ; 32 Q(KQ)=RN(K)
46640 HRLZI 3,XRN ; PUT ADDR OF RN IN LEFT HALF
46645 HRRI 3,Q(2) ; ADDR OF NEXT OPEN SLOT OF Q IN RIGHT HALF
46650 ADDI 2,(4) ; TO LOCATE END OF TRANSFER
46655 BLT 3,Q(2) ; THESE REPLACE THE ';;' ABOVE
46670 MOVEM 2,@(16) ; NEW VALUE OF KQ
46672 MOVEI 1
46674 MOVEM LLL ; L
46676 MOVEM XXX ; LK
46680 JRA 16,1(16)
46690
47000 PSHFT: 0 ; CALL PSHFT(KK,K)
47010 MOVE 6,@1(16)
47020 MOVE 2,@(16)
47030 MOVE 2,PX-1(2)
47040 FIXX(2) ; NA
47050 ;C DO 31 NA=IFIX(PN(KK)),IFIX(PN(K+1)-1.)
47052 MOVE 3,PX(6) ; RN(KL)=Q(NA)
47054 FIXX(3) ; 31 KL=KL+1
47080 MOVE 4,SF ; KL
47090 PS31: MOVE 5,Q-1(2)
47100 MOVEM 5,XRN-1(4)
47110 AOJ 2,
47120 CAME 2,3
47130 AOJA 4,PS31
47140 AOJ 4,
47150 MOVEM 4,SF ; KL
47160 AOJ 6,
47170 MOVEM 6,@(16) ; KK
47180 JRA 16,2(16)
47300
47325 ; SUBROUTINE ADDRST(RPOS,XWDS,PN)
47350 ; COMMON /XXX/LK,LP,JY /PTR/PWDS(250),L,LL,I,IX
47375 ; COMMON RS,JA,REST,J2,RQ(18),JX,JR,LX,RDIS
47400 ; DIMENSION XWDS(1),PN(1)
47500
47600 ADRST: 0 ; PN(LK)=6
47700 MOVE 1,XXX ; LK
47800 MOVE 6,[6.0] ; CALL ADRST(XWDS)
47900 MOVEM 6,PX-1(1)
48000 MOVE 2,[2.0] ; PN(LK+1)=2
48100 MOVEM 2,PX(1)
48200 ;; MOVE 13,.COMM. ; PN(LK+2)=RS
48300 SETZM PX+1(1)
48400 MOVE 3,SHFT1 ; PN(LK+3)=RPOS-1. (SHFT1 SAVED 'RR')
48500 MOVEM 3,PX+=11(1) ; SEE (LK+3) BELOW
48600 FSBR 3,[1.0]
48700 MOVEM 3,PX+2(1)
48800 SETZM PX+3(1) ; PN(LK+4)=0
48900 SETZM PX+4(1) ; PN(LK+5)=0
49000 SETZM PX+5(1) ; PN(LK+6)=0
49100 MOVEM 6,PX+6(1) ; PN(LK+7)=6.
49200 MOVE 10,[1.0]; PN(LK+8)=-1
49300 MOVNM 10,PX+7(1)
49400 ; LK=LK+9
49500 ; L=L+1
49600 ; XWDS(L)=LK
49700 ; NEXT ADDS A BAR LINE
49800 MOVEM 2,PX+=8(1) ; PN(LK)=2
49900 MOVE [4.0] ; PN(LK+1)=4
50000 MOVEM PX+=9(1)
50100 ;; MOVEM 13,PX+=10(1) ; PN(LK+2)=RS
50150 SETZM PX+=10(1)
50200 ; PN(LK+3)=RPOS (SEE ABOVE)
50300 MOVEM 10,PX+=12(1) ; PN(LK+4)=1.
50400 ; LK=LK+5
50500 ; L=L+1
50600 ; XWDS(L)=LK
50700 ; END
50800 MOVE 2,LLL ; L
50900 HRRZ 3,(16) ; ADDR OF XWDS
51000 ADDI 3,(2)
51100 ADDI 1,=9
51200 MOVE 4,1
51300 TLC 4,232000 ; NEXT FLOATS IT
51400 FADR 4,4
51500 MOVEM 4,(3) ;XWDS(L)=LK
51600 AOJ 3,
51700 FADR 4,[5.0]
51800 MOVEM 4,(3) ;XWDS(L+1)=LK
51900 ADDI 2,2
52000 MOVEM 2,LLL ;L=L+2
52100 ADDI 1,5
52200 MOVEM 1,XXX ;LK=LK+14
52300 JRA 16,1(16)
52400
52500 ENDL: 0
52550 MOVE 5,[4.0]
52600 SETZ 2, ; JJ
52700 MOVEI 3,1 ; K
52800 E7: MOVE 4,PX-1(3)
52900 FIXX(4)
53000 CAME 5,Q(4)
53100 JRST E77
53200 AOJ 2,
53300 MOVE Q+2(4)
53400 MOVEM XRN-1(2)
53500 E77: CAMGE 3,LLL
53600 AOJA 3,E7
53700 MOVEM 2,@(16)
53800 JRA 16,1(16)
53900
54000 STAFF: 0 ; SUBROUTINE STAFF(P0,P1, P3,P4,P5,P6,P7,P8)
54100 ;; COMMON/XRN/RN(2000) /SF/KL,RT,KP,RSTJ2,NAMX
54200 ;; COMMON /PTR/PWDS(250),L,LL,I,IX
54300 MOVE 2,SF+2 ; KP PWDS(KP)=KL
54400 MOVE 4,SF ; KL
54500 MOVEI 3,(4)
54600 TLC 3,232000 ; FLOAT
54700 FADR 3,3
54800 MOVEM 3,PTR-1(2)
54900 AOJ 2, ; KP=KP+1
55000 MOVEM 2,SF+2
55100 MOVE 2,@(16) ; RN(KL)=P0
55200 MOVEM 2,XRN-1(4)
55300 MOVE @1(16) ; RN(KL+1)=P1
55400 MOVEM XRN(4)
55500 MOVE SF+1 ; RN(KL+2)=RT
55600 MOVEM XRN+1(4)
55700 MOVE @2(16) ; RN(KL+3)=P3
55800 MOVEM XRN+2(4)
55900 MOVE @3(16) ; RN(KL+4)=P4
56000 MOVEM XRN+3(4)
56100 MOVE @4(16) ; RN(KL+5)=P5
56200 MOVEM XRN+4(4)
56300 CAMGE 2,[4.0] ; IF(P0.LT.4.)GO TO 1
56400 JRST ST1
56500 MOVE @5(16) ; RN(KL+6)=P6
56600 MOVEM XRN+5(4)
56700 CAMGE 2,[5.0] ; IF(P0.LT.5)GO TO 1
56800 JRST ST1
56900 MOVE @6(16) ; RN(KL+7)=P7
57000 MOVEM XRN+6(4)
57100 CAMGE 2,[6.0] ; IF(P0.LT.6)GO TO 1
57200 MOVEM XRN+6(4)
57300 MOVE @7(16) ; RN(KL+8)=P8
57400 MOVEM XRN+7(4)
57500 ST1: FIXX(2) ;1 KL=KL+P0+3.
57600 ADDI 2,3
57700 ADDM 2,SF
57800 JRA 16,8(16) ; END
57900
58000 RIGHT: 0 ; FUNCTION RIGHT(NA,J)
58100 ;; COMMON /PX/PN(1800) /Q/Q(9000)
58200 MOVE 4,@(16) ; NA K=NA+J
58300 ADD 4,@1(16) ; +J J IS EITHER +1 OR -1
58400 RT1: MOVE 3,PX-1(4) ; 1 L=PN(K)
58500 FIXX(3) ; L
58600 MOVE Q(3 ; IF(Q(L+1).NE.16)GO TO 2
58700 CAME [16.0] ; **** CAN'T USE AC2 - USED IN FORTRAN
58800 JRST RT2
58900 ADD 4,@1(16) ; K=K+J
59000 JRST RT1 ; GO TO 1
59100 RT2: MOVE Q+2(3) ; 2 RIGHT=Q(L+3)
59200 JRA 16,2(16) ; END
59250
59300 LOOP1: 0 ;CALL LOOP1
59400 MOVE 1,[8.0] ; RSTAFF=RSTAFF+8
59500 FADRB 1,RCLF+4
59600 MOVE 2,RCLF+2
59700 P477: MOVE 4,RCLF ; DO 477 K=KW,ITEM+1
59800 FADRB 4,PTR-1(2) ; PWDS(K)=PWDS(K)+R
59900 FIXX(4) ; LA=PWDS(K)+2
60100 FADRM 1,XRN+1(4) ;477 RN(LA)=RN(LA)+RSTAFF
60200 CAMG 2,RCLF+3
60300 AOJA 2,P477
60400 JRA 16,(16) ; FOR COMBINED FILES
60500
60600 RESTS: 0 ;XLFT=0 -- CALL RESTS
60610 SETZ 2,
60620 MOVE 3,[-99.0] ;SIG=-99
60630 ;; MOVE 4,3 ;CLEF=-99
60900 SETZ 6, ; REST=0
61000 MOVEI 7,1 ;K=1
61100 RX50: MOVE 10,PX-1(7) ;50 JL=PN(K)
61110 FIXX(10)
61200 MOVE 11,Q(10) ;R=Q(JL+1)
61300 JUMPN 2,RX5 ;IF(XLFT.NE.0)GO TO 5
61400 CAMLE 11,[4.0] ;IF(R.LE.4)XLFT=Q(JL+3)
61405 JRST RX5
61410 MOVE 2,Q+2(10)
61510 MOVEM 2,.COMM.+=13
61610 JRST RX3
62300 RX5: CAME 11,[17.0] ;5 IF(R.NE.17)GO TO 3
62310 JRST RX3
62400 MOVE 1,Q+4(10) ;IF(Q(JL+5).EQ.SIG)GO TO 60
62410 CAMN 1,3
62420 JRST RX60
62500 MOVE 3,1 ;SIG=Q(JL+5)
62600 RX3: CAME 11,[2.0] ;3 IF(R.NE.2)GO TO 231
62610 JRST RX231
62700 MOVE Q-1(10) ;IF(Q(JL).GE.6)GO TO 7
62710 CAML [6.0]
62720 JRST RX7
62800 MOVE 1,PX-2(7) ;IF(Q(IFIX(PN(K-1))+1).NE.4)GO TO 231
62810 FIXX(1)
62820 MOVE Q(1)
62830 CAME [4.0]
62840 JRST RX231 ; ANY REST BETWEEN 2 BARS IS A "WHOLE" REST.
63000 ; WON'T CATCH IT IF THERE IS A CLEF, METER, ETC. PRESENT
63100 MOVE 1,PX(7) ;IF(Q(IFIX(PN(K+1))+1).NE.4)GO TO 231
63110 FIXX(1)
63120 MOVE Q(1)
63130 CAME [4.0]
63140 JRST RX231
63200 ; FOUND A WHOLE REST MEAS.
63300 RX7: JUMPN 6,RX6 ;7 IF(REST.NE.0)GO TO 6
63400 MOVEI 13,(10) ;JR=JL+8
63450 ADDI 13,6
63500 ; POINTER TO REST NUM.
63600 MOVE 11,Q(13) ;R=Q(JR-1)
63700 CAMGE 11,[5.0] ;IF(R.LT.5)R=5
63710 MOVE 11,[5.0]
63800 FMPR 11,[0.6] ;Q(JR-1)=R*.6
63810 MOVEM 11,Q(13)
63900 ; REDUCE SIZE OF REST'S TIME SO IT WILL TAKE LESS SPACE.
64000 RX6: FADR 6,[1.0] ;6 REST=REST+1
64100 MOVEM 6,Q+1(13) ;Q(JR)=REST
64200 MOVEI 10,(7) ;JL=K+2
64210 ADDI 10,2
64300 CAML 10,LLL ;IF(JL.GE.L)RETURN
64310 JRA 16,(16)
64700 MOVE 14,PX-1(10) ;LB=PN(JL)
64710 FIXX(14)
64800 MOVE Q(14) ;IF(Q(LB+1).NE.2)GO TO 233
64810 CAME [2.0]
64820 JRST RX233 ; NEXT IS TO COMBINE MEASURES OF REST
65000 MOVE Q-1(14) ;IF(Q(LB).LT.6)GO TO 233
65010 CAMGE [6.0]
65020 JRST RX233
65100 ; SKIP NON-WHOLE RESTS
65200 MOVE 15,PX-2(10) ;N=PN(JL-1)
65210 FIXX(15)
65300 MOVE Q(15) ;IF(Q(N+1).NE.4)GO TO 233
65310 CAME [4.0]
65320 JRST RX233
65400 ; IS REST FOLLOWED BY A BAR?
65500 ; SO IT WON'T BE FOUND NEXT TIME AROUND.
65600 MOVN [1.0] ;Q(LB+1)=-1
65610 MOVEM Q(14)
65700 ; CHANGE CODE #
65800 MOVEM Q(15) ;Q(N+1)=-1
65900 MOVEI 7,(10) ;K=JL
66000 JRST RX6 ;GO TO 6
66100 RX60: MOVE [1.0] ;60 Q(JL+1)=-1
66133 MOVNM Q(10)
66166 JRST RX231 ;GO TO 231
66200 RX233: SETZ 6, ;233 REST=0
66300 RX231: AOJ 7, ;231 K=K+1
66400 CAMGE 7,LLL ;IF(K.LT.L)GO TO 50
66410 JRST RX50
66420 JRA 16,(16) ; END
66500
66600 EXCHG: 0 ;CALL EXCHG(MM(J),NN(J))
66700 HRRZI 1,@(16) ; ADDR OF MM(J)
66800 MOVE 2,1(1) ;VALUE OF MM(J+1)
66900 EXCH 2,@(16) ;EXCHANGE
67000 MOVEM 2,1(1) ; MM(J+1)
67100 HRRZI 1,@1(16) ; ADDR OF NN(J)
67200 MOVE 2,1(1) ;VALUE OF NN(J+1)
67300 EXCH 2,@1(16) ;EXCHANGE
67400 MOVEM 2,1(1) ; NN(J+1)
67500 JRA 16,2(16)
67600 END